home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue43 / system / listings.pas
Encoding:
Pascal/Delphi Source File  |  1999-02-08  |  4.8 KB  |  143 lines

  1. { IMPORTANT NOTE: This code is provided for illustrative purposes only, remember that
  2.   you need to take these ideas and rework them for use in your own programs, in order
  3.   to achieve adequate security }
  4.   
  5. { Listing 1 }
  6.  
  7. function DelphiIDERunning : Boolean;
  8. begin
  9.     Result := FindWindow ('TAppBuilder', Nil) <> 0;
  10.     if Result then Result := FindWindow ('TApplication', Nil) <> 0;
  11.     if Result then Result := FindWindow ('TPropertyInspector', 'Object Inspector') <> 0;
  12.     if Result then Result := FindWindow ('TProjectManager', 'Project Manager') <> 0;
  13.     ---- etc ----
  14. end;
  15.  
  16. { Listing 2 }
  17.  
  18. function DelphiIDERunning: Boolean;
  19. type
  20.     GetProcAddressType = function (hMod: hModule; FuncName: PChar): Pointer; stdcall;
  21.     FindWindowType = function (ClassName, WndName: PChar): hWnd; stdcall;
  22. var
  23.     modKernel, modUser: hModule;
  24.     lpProcAddress: GetProcAddressType;
  25.     lpFindWindow: FindWindowType;
  26. begin
  27.     Result := False;
  28.     modUser := GetModuleHandle ('USER32.DLL');
  29.     if modUser <> 0 then begin
  30.         modKernel := GetModuleHandle ('KERNEL32.DLL');
  31.         if modKernel <> 0 then begin
  32.             lpProcAddress := GetProcAddress (modKernel, 'GetProcAddress');
  33.             if @lpProcAddress <> Nil then begin
  34.                 lpFindWindow := lpProcAddress (modUser, 'FindWindowA');
  35.                 if @lpFindWindow <> Nil then begin
  36.                     Result := lpFindWindow ('TAppBuilder', Nil) <> 0;
  37.                 end;
  38.             end;
  39.         end;
  40.     end;
  41. end;
  42.  
  43. { Listing 3 }
  44.  
  45. const
  46.     szUser32DLL:      String = Chr(230)+Chr(230)+Chr(238)+Chr(132)+Chr(152)+Chr(153)+Chr(248)+
  47.                   Chr(239)+Chr(249)+Chr(255);
  48.     szKernel32DLL:    String = Chr(230)+Chr(230)+Chr(238)+Chr(132)+Chr(152)+Chr(153)+Chr(230)+
  49.                   Chr(239)+Chr(228)+Chr(248)+Chr(239)+Chr(225);
  50.     szGetProcAddress: String = Chr(217)+Chr(217)+Chr(207)+Chr(216)+Chr(206)+Chr(206)+Chr(235)+
  51.                   Chr(201)+Chr(197)+Chr(216)+Chr(250)+Chr(222)+Chr(207)+Chr(237);
  52.     szFindWindowA:    String = Chr(235)+Chr(221)+Chr(197)+Chr(206)+Chr(196)+Chr(195)+Chr(253)+
  53.                   Chr(206)+Chr(196)+Chr(195)+Chr(236);
  54.     szTAppBuilder:    String = Chr(216)+Chr(207)+Chr(206)+Chr(198)+Chr(195)+Chr(223)+Chr(232)+
  55.                   Chr(218)+Chr(218)+Chr(235)+Chr(254);
  56.  
  57. function MassageString (const S: String): String;
  58. var
  59.     Idx: Integer;
  60. begin
  61.     SetLength (Result, Length (S));
  62.     for Idx := 0 to Length (S) - 1 do
  63.         Result [Idx + 1] := Chr (Ord (S [Length (S) - Idx]) xor $AA);
  64. end;
  65.  
  66. function DelphiIDERunning: Boolean;
  67. type
  68.     GetProcAddressType = function (hMod: hModule; FuncName: PChar): Pointer; stdcall;
  69.     FindWindowType = function (ClassName, WndName: PChar): hWnd; stdcall;
  70. var
  71.     modKernel, modUser: hModule;
  72.     lpProcAddress: GetProcAddressType;
  73.     lpFindWindow: FindWindowType;
  74. begin
  75.     Result := False;
  76.     modUser := GetModuleHandle (PChar (MassageString (szUser32DLL)));
  77.     if modUser <> 0 then begin
  78.         modKernel := GetModuleHandle (PChar (MassageString (szKernel32DLL)));
  79.         if modKernel <> 0 then begin
  80.             lpProcAddress := GetProcAddress (modKernel, PChar (MassageString (szGetProcAddress)));
  81.             if @lpProcAddress <> Nil then begin
  82.                 lpFindWindow := lpProcAddress (modUser, PChar (MassageString (szFindWindowA)));
  83.                 if @lpFindWindow <> Nil then begin
  84.                     Result := lpFindWindow (PChar (MassageString (szTAppBuilder)), Nil) <> 0;
  85.                 end;
  86.             end;
  87.         end;
  88.     end;
  89. end;
  90.  
  91.  
  92. { Listing 4 }
  93.  
  94. procedure MassageToClip (const S: String);
  95. var
  96.     Idx: Integer;
  97.     Str: String;
  98. begin
  99.     for Idx := 1 to Length (S) do begin
  100.         if Idx <> 1 then Str := Str + '+';
  101.         Str := Str + Format ('Chr(%d)', [Ord (S [Idx])]);
  102.     end;
  103.  
  104.     Clipboard.SetTextBuf (PChar (Str));
  105. end;
  106.  
  107. { Listing 5 }
  108.  
  109. procedure TMain.Refresh;
  110. var
  111.     MoreToDo: Boolean;
  112.     Snapshot: THandle;
  113.     pe: TProcessEntry32;
  114.     Node: TdxTreeListNode;
  115. begin
  116.     TreeList.ClearNodes;
  117.     TreeList.BeginUpdate;
  118.  
  119.     try
  120.         Snapshot := CreateToolhelp32Snapshot (th32cs_SnapProcess, 0);
  121.         try
  122.             pe.dwSize := sizeof (pe);
  123.             MoreToDo := Process32First (Snapshot, pe);
  124.             while MoreToDo do begin
  125.                 Node := TreeList.Add;
  126.                 Node.Values [0] := ExtractFileName (StrPas (pe.szExeFile));
  127.                 Node.Values [1] := IntToHex (pe.th32ProcessID, 8);
  128.                 Node.Values [2] := pe.pcPriClassBase;
  129.                 Node.Values [3] := pe.cntThreads;
  130.                 Node.Values [4] := pe.dwFlags;
  131.                 Node.Values [5] := StrPas (pe.szExeFile);
  132.                 MoreToDo := Process32Next (Snapshot, pe);
  133.             end;
  134.         finally
  135.             CloseHandle (Snapshot);
  136.         end;
  137.     finally
  138.         TreeList.EndUpdate;
  139.         SelNode := TreeList.TopNode;
  140.     end;
  141. end;
  142.  
  143.